Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/TPAVATAR.PAS

Pascal/Delphi Source File | 1996-04-20 | 11KB | 350 lines

Unit TpAvatar;                    { er jeg ikke opfindsom ? }

 { This is a unit for implementing Avatar control sequences conforming to   }
 { AVT/0 in Turbo Pascal. The implementation is based on information        }
 { available in the FSC-0025 and FSC-0037 docs.                             }
 { Notes:                                                                   }
 { Insert mode is not fully implemented as ^V^Y does not respect it. This   }
 { will come at a later date.                                               }

Interface

Uses Use32, OpCrt, OpString;
{ As you can see, I have used two units from Turbo Power Professional (TPro)}
{ To a certain extent you can use Crt and PoorMan instead. The routines not }
{ present in the PoorMan unit you will have to implement yourself.          }

Const
  DefaultColor   : Byte = Cyan;
  InsertMode     : Boolean = False;

Procedure AvatarWrite(Ch : Char);
Function In_Avatar : Boolean;
Procedure ClearAvatarState;

Implementation

Type
  States         = (Waiting, Whee, Gotcha, Rower, Columnizer,
                    Yuck, YuckNum, ScrollNum, ScrollUpper,
                    ScrollLeft, ScrollLower, ScrollRt, L1, L2, L3,
                    M1, M2, M3, M4, Ynum, Ych, Ytimes);

Const
  Up = True;
  Down = False;

Var
  Direction : Boolean;
  NextState      : States;
  WindLo, WindHi,
  NextRow, NextColumn,
  Num            : Word;
  xlo, ylo,
  xhi, yhi       : Byte;
  RChar          : Char;

  St             : String;

  Procedure ClearAvatarState;
  BEGIN
    NextState:=Waiting;
  END;

  Function In_Avatar : Boolean;
  Begin
    In_Avatar := NextState <> Waiting;
  End {In_Avatar} ;

  Procedure AvatarWrite(Ch : Char);
  Begin
    Case NextState Of
      Waiting :
        Case Ch Of
          ^V :
            Begin
              NextState := Whee;
              InsertMode := False;
            end;
          ^Y : NextState := Yuck;
          ^L :
            Begin
              TextAttr := DefaultColor;
              InsertMode := False;
              ClrScr;
            end;
          Else
            If InsertMode And (WhereXAbs < Lo(WindMax)) then
            Begin
{
              ReadAttributeWindow(Lo(WindMax)-WhereX, WhereY, WhereX, St2);
              FastReadWindow(Lo(WindMax)-WhereX, WhereY, WhereX, St);
              FastWriteWindow(Copy(Ch + St,1,Lo(WindMax)-WhereX+1), WhereY, WhereX,TextAttr);
              WriteAttributeWindow(Copy(Chr(TextAttr)+ St2,1,Lo(WindMax)-WhereX+1), WhereY, WhereX);
}
            end
            else Write(Ch);
        End {Case} ;
      Whee :
        Begin
          If Ch <> ^Y then InsertMode := False;
          Case Ch Of
            ^A :
              Begin
                NextState := Gotcha;
                TextAttr := Ord(Ch);
              End;
            ^B :
              Begin
                NextState := Waiting;
                TextAttr := TextAttr Or $80;
              End;
            ^C :
              Begin
                NextState := Waiting;
                GotoXY(WhereX, WhereY - 1);
              End;
            ^D :
              Begin
                NextState := Waiting;
                GotoXY(WhereX, WhereY + 1);
              End;
            ^E :
              Begin
                NextState := Waiting;
                GotoXY(WhereX - 1, WhereY);
              End;
            ^F :
              Begin
                NextState := Waiting;
                GotoXY(WhereX + 1, WhereY);
              End;
            ^G :
              Begin
                NextState := Waiting;
                ClrEol;
              End;
            ^H :
              NextState := Rower;
            ^I :
              Begin
                InsertMode := True;
                NextState := Waiting;
              end;
            ^J :
              Begin
                Direction := Up;
                NextState := ScrollNum;
              end;
            ^K :
              Begin
                Direction := Down;
                NextState := ScrollNum;
              end;
            ^L :
              NextState := L1;
            ^M :
              NextState := M1;
            ^N :
              Begin
{
                ReadAttributeWindow(Lo(WindMax)-WhereX, WhereY, WhereX+1, St2);
                FastReadWindow(Lo(WindMax)-WhereX, WhereY, WhereX+1, St);
                FastWriteWindow(St + ' ', WhereY, WhereX,TextAttr);
                WriteAttributeWindow(St2 + Chr(TextAttr), WhereY, WhereX);
}
              end;
            ^Y :
              NextState := Ynum;
            Else
              NextState := Waiting;
              If InsertMode And (WhereXAbs < Lo(WindMax)) then
              Begin
{
                ReadAttributeWindow(Lo(WindMax)-WhereX, WhereY, WhereX, St2);
                FastReadWindow(Lo(WindMax)-WhereX, WhereY, WhereX, St);
                FastWriteWindow(Copy(Ch + St,1,Lo(WindMax)-WhereX+1), WhereY, WhereX,TextAttr);
                WriteAttributeWindow(Copy(Chr(TextAttr)+ St2,1,Lo(WindMax)-WhereX+1), WhereY, WhereX);
}
              end
              else Write(Ch);
          End {Case Ch} ;
        End;
      Gotcha :
        Begin
          NextState := Waiting;
          TextAttr := Ord(Ch);
        End;
      Rower :
        Begin
          NextState := Columnizer;
          NextRow := Ord(Ch);
          If (NextRow < 1) Then NextRow := 1
          Else
            If (NextRow + Lo(WindMin) > Lo(WindMax) + 1)
          Then NextRow := Lo(WindMax) - Lo(WindMin) + 1;
        End;
      Columnizer :
        Begin
          NextState := Waiting;
          NextColumn := Ord(Ch);
          If (NextColumn < 1) Then
            NextColumn := 1
          Else
            If (NextColumn + Hi(WindMin) > Hi(WindMax) + 1) Then
            NextColumn := Hi(WindMax) - Hi(WindMin) + 1;
          GotoXY(NextColumn, NextRow);
        End;
      Yuck :
        Begin
          NextState := YuckNum;
          RChar := Ch;
        End;
      YuckNum :
        Begin
          Num := Byte(Ch);
          NextState := Waiting;
          if InsertMode then
          Begin
            For xlo := 1 to Num do
              if WhereXAbs < Lo(WindMax) then
              Begin
{
                ReadAttributeWindow(Lo(WindMax)-WhereX, WhereY, WhereX, St2);
                FastReadWindow(Lo(WindMax)-WhereX, WhereY, WhereX, St);
                FastWriteWindow(Copy(RChar + St,1,Lo(WindMax)-WhereX+1), WhereY, WhereX,TextAttr);
                WriteAttributeWindow(Copy(Chr(TextAttr)+ St2,1,Lo(WindMax)-WhereX+1), WhereY, WhereX);
}
              end
            else Write(RChar);
          end
          else for xlo := 1 to num do Write(RChar);
        End;
      ScrollNum: { number of lines to scroll }
        Begin
          Num := Byte(Ch);
          NextState := ScrollUpper;
        end;
      ScrollUpper : { Upper limit }
        Begin
          ylo := Byte(Ch);
          NextState := ScrollLeft;
        end;
      ScrollLeft :
        Begin
          xlo := Byte(Ch);
          NextState := ScrollLower;
        end;
      ScrollLower :
        Begin
          yhi := Byte(Ch);
          NextState := ScrollRt;
        end;
      ScrollRt :
        Begin
          xhi := Byte(Ch);

          {clip coordinates and convert to absolute coordinates}

          if Xlo = 0 then Xlo := 1;
          if Ylo = 0 then Ylo := 1;
          if (Xhi > Lo(WindMax) - Lo(WindMin) + 1)
          then Xhi := Lo(WindMax)
          else Xhi := Lo(WindMin) + Xhi - 1;
          if (Yhi > Hi(WindMax) - Hi(WindMin) + 1)
          then Yhi := Hi(WindMax)
          else Yhi := Hi(WindMin) + Yhi - 1;
          xhi := xhi + Lo(WindMin) -1;
          yhi := yhi + Hi(WindMin) -1;

          If Direction = Up
          then OpCrt.ScrollWindowUp(xlo, ylo, xhi, yhi, num)
          else OpCrt.ScrollWindowDown(xlo, ylo, xhi, yhi, num);
          NextState := Waiting;
        end;
      L1 : { attribute to use }
        Begin
          TextAttr := Byte(Ch);
          NextState := L2;
        end;
      L2 : { number of lines to clear }
        Begin
          num := Byte(Ch);
          NextState := L3; { alternate: RChar := ' '; NextState := M4;}
        end;               { (saves one state)                        }
      L3 : { number of columns }
        Begin
          xhi := Byte(Ch);
          xlo := Lo(WindMin) + WhereX -1;
          ylo := Hi(WindMin) + WhereY -1;
          xhi := Lo(WindMin) + xhi -1;
          yhi := Hi(WindMin) + num -1;
          if (Xhi > Lo(WindMax)) then Xhi := Lo(WindMax);
          if (Yhi > Hi(WindMax)) then Yhi := Hi(WindMax);
          num := 0;
          OpCrt.ScrollWindowUp(xlo, ylo, xhi, yhi, num);
          NextState := Waiting;
        end;
      M1 :
        Begin
          TextAttr := Byte(Ch);
          NextState := M2;
        end;
      M2 :
        Begin
          RChar := Ch;
          NextState := M3;
        end;
      M3 : { number of lines to clear }
        Begin
          num := Byte(Ch);
          NextState := M4;
        end;
      M4 : { number of columns }
        Begin
          NextRow := Byte(Ch);
          { convert to absolute coordinates }
          xlo := Lo(WindMin) + WhereX -1;
          ylo := Hi(WindMin) + WhereY -1;
          xhi := Lo(WindMin) + NextRow -1;
          yhi := Hi(WindMin) + num -1;
          { clip to fit window }
          if (Xhi > Lo(WindMax)) then Xhi := Lo(WindMax);
          if (Yhi > Hi(WindMax)) then Yhi := Hi(WindMax);
          { save current coordinates }
          WindHi := windMax; WindLo := WindMin;
          { fill desired area with desired char }
          Window(xlo, ylo, xhi, yhi);
{          FastFillwindow(NextRow * Num, RChar, 1, 1, TextAttr);}
          { restore coordinates }
          WindMax := WindHi; WindMin := WindLo;
          NextState := Waiting;
        end;
      Ynum :
        Begin
          Num := Byte(Ch);
          St := '';
          NextState := Ych;
        End;
      Ych :
        Begin
          St := St + Ch;
          Dec(num);
          if Num = 0
          then NextState := Ytimes
          else NextState := Ych;
        end;
      Ytimes :
        Begin
          Xlo := Byte(Ch);
          { expand string }
          For xhi := 1 to xlo do Write(St);{ /// treat insertmode here /// }
          NextState := Waiting;
        end;
    End {Case NextState} ;
  End {AvatarWrite} ;

Begin
  NextState := Waiting;
End.